#!/usr/bin/env perl
# Time-stamp: <27 Apr 00 18:16:51 giron1>

=head1 NAME

makedblists.perl - speech files lists generator

=head1 SYNOPSIS

makedblists.perl [commands] [options] I<corpus>

see also:

L<"COMMANDS">,
L<"OPTIONS">

at the end of this document.

=head1 DESCRIPTION

This program generates lists of available speech files from a defined
location (normally the cdrom server). It creates lists of file names
for a defined I<corpus> and its subcorpora. The resulting lists are the
result of a find for files with one of the extensions dependent from
the current I<corpus>. The corpora is defined in the I<globals.pl> file
in the root defined by the I<groot> option. In the case of SAM speech
files the extensions are determined automatically.

=head1 SEE ALSO

L<OPTIONS|OPTIONS_HTML/OPTIONS>,
L<GLOBALS|GLOBALS_HTML/GLOBALS>,
L<SAM2ESPS|SAM2ESPS_HTML/SAM2ESPS>

=head1 AUTHOR

  $Id: makedblists.perl,v 1.1 2007/10/08 09:26:02 schweitz Exp $
  Franck Giron

=head1 LOG

  $Log: makedblists.perl,v $
  Revision 1.1  2007/10/08 09:26:02  schweitz
  version 2.4, lib vergessen

  Revision /main/14  22-Jan-2003.16:17:57  mmimgr
  Adding some debugging info.
  
  Revision /main/13  17-Jan-2003.12:25:47  giron1
  Updating header to /usr/bin/env perl.
  
  Revision 1.11  2000/05/12 14:57:14  giron1
  small change in call to requireglob
  
  Revision 1.10  2000/04/27 11:26:41  giron1
  Pod documentation updated
  

=cut

#----------------------------------------------------------------------
# perl packages
#----------------------------------------------------------------------
use strict;
use FileHandle;

use Misc;
use myFind;
use GLOBALS;
use OPTIONS;
use SAM2ESPS;

#----------------------------------------------------------------------

=head1 FUNCTIONS

Here are the different functions

=head2 GenerateList

  This function is the core for the generation of speech files list
  
  The following variables have to be defined in the calling routine
  $opt_l    : The list of options coming from the argument list
  $path_db  : The path for the current database
  $ext_l    : The list of file extensions valid for the speech sound
  files of the current database
  $corp     : The corpus name

=cut

#----------------------------------------------------------------------

sub GenerateList{
  my ($opt_l,$path_db,$ext_l,$corp) = @_;
  my ($basefindpath,$rootfind);
  
  # test if the corpus belongs to STC standard
  my $stcstandard = grep(/$corp/,@GLOBALS::STC_FORMAT_CORPUS_LIST);
  
  # test if the sound directory is existing
  my $dsound = $opt_l->{dsound}{string} . $path_db;
  if (not $stcstandard and not -d $dsound ) {
    warn "Sound directory $dsound not existent\n";
    return -1;
  }
  
  # Test if the list name option has been given
  my $listd = $opt_l->{ldir}{string};
  my $listname = $listd;
  if ($opt_l->{lname}{string} ne '') {$listname .= $opt_l->{lname}{string};}
  # if not then list name is defined as equal to the database directory
  else {$listname .= $path_db;$listname =~ s/\/$//;}
  $listname .= $opt_l->{elist}{string};
  
  warn "Creating list $listname\n"; 
  
  # Test if the list file already exists
  if ( -r $listname and not $opt_l->{locreate}{Do}) {
    warn "$listname already created.\n";
    return -1;
  }
  
  # Determine which file extensions we are searching for
  my $pattern = '';
  foreach (@{$ext_l}) { 
    $pattern .= '.*\.'. $_ .'|';
  }  
  chop $pattern;
  warn "File extension pattern: $pattern\n";
  
  my @listUniq = ();
  # Determine the list of files for STC standard
  if ($stcstandard) {
    # Determines the main possible directories for search
    $rootfind = "$opt_l->{dsound}{string}";
    if (not opendir(DIR,$rootfind)) {
      warn "Can't open $rootfind: $!\n";
      return -1; 
    }
    my @dirnames = sort readdir(DIR);
    closedir(DIR);
    warn "matching in: @dirnames\n";
    
    # Look for all defined directory in the corpus
    my $dir;
    foreach $dir (@{$GLOBALS::{$corp}{$path_db}}) {
      warn "looking for $dir with pattern: $opt_l->{rpat}{string}\n";
      chop $dir;
      my $findpath = '';
      foreach (@dirnames) {
	if (m/$opt_l->{rpat}{string}/) {
	  warn "matched $_\n";
	  $basefindpath = $rootfind . $_;
	  $findpath = $basefindpath . '/' . lc $dir . '/';
	  warn "$findpath ?\n";
	  if (-d $findpath) {
	    warn "$findpath found!\n";
	    $opt_l->{loc}{Root}{$dir} = $_;
	    last;
	  } else {$findpath = '';}
	}
      }
      if ($findpath eq '') {
	warn "$dir not matched !\n";
	next;
      }
      next if ($opt_l->{locreate}{Do});
      
      # Searches the files in the database directory
      $::PREVIOUS = '';
      my $list = find(\&wanted,$pattern,$findpath);
      
      # Suppresses UTR_DIR from path names
      # and convert base root to future stored one
      foreach (@$list) {
	s/$basefindpath/$opt_l->{lang}{string}\/$path_db/i;
	s/$GLOBALS::UTR_DIR\///i;
      }
      # Stores list
      push @listUniq, @$list;
      undef $list;
    }
  } else { 
    # Determines the list of files for other databases
    $rootfind = "$opt_l->{dsound}{string}$path_db";
    
    # Search the files in the database directory
    $::PREVIOUS = '';
    my $list = find(\&wanted,$pattern,$rootfind);
    
    # Convert base root to future stored one
    foreach (@$list) {
      s/$opt_l->{dsound}{string}/$opt_l->{lang}{string}\//;
      push @listUniq, $_;
    }
  }
  
  # remove successive double entries
  my @listSort = uniq @listUniq;
  
  # If it contains something, store it
  if ($#listSort > 0) {
    warn 'Final list has :',$#listSort+1," entries\n";
    my $fhout = new FileHandle;
    if ($fhout->open("> $listname") ) {
      warn "Storing list in: $listname\n";
      foreach (@listSort) {$fhout->print("$_\n")};
    } else {
      warn "Error by opening $listname\n";
      return;
    }
    $fhout->close;
  } else {
    # or print error message
    warn "$path_db is empty.\n";
  }
}

#----------------------------------------------------------------------

=head2 wanted

  This subroutine is used to match a pattern in the find program
  
  The following variables have to be defined in the calling routine
  $pat      : The search pattern
  $list     : The resulting list

=cut

#----------------------------------------------------------------------

sub wanted {
  my ($pat,$list) = @_;
  my ($name);
  
  if (m/^(?:$pat)$/i) {
    $name = $myFind::name;
    $name =~ s/\.[^.]*$//;
    if ($name ne $::PREVIOUS) {
      push @{$list}, $name;
      $::PREVIOUS = $name;
    }
  }
}

#----------------------------------------------------------------------

=head2 define_options

  This function defines options which are dependent of the corpus and
  global variables
  
  The following variables have to be defined in the calling routine
  $corp      : The name of the corpus to be treated
  $opt       : The options list
  $popt      : The previous options list

=cut

#----------------------------------------------------------------------

sub define_options {
  my ($corp,$opt,$popt) = @_;
  
  # Language option
  $opt->define($popt,'lang',$GLOBALS::DBLANG,
	       "<Iso3>\t: language three letters code from Iso 3166/2T ");
  # Global root
  $opt->define($popt,'groot',$GLOBALS::GLOBALS_PATH,"<dir>\t: global path ");
  
  # Sound directory
  $opt->define($popt,'dsound','/cdromserv/views_pc/',
	       "<dir>\t: root directory for speech sound files ");
  # Lists directory
  $opt->define($popt,'ldir',$GLOBALS::CORPUS_H->{$corp}{list_dir},
	       "<dir>\t: lists root directory of the defined corpus\n\t\t  ");
  # List name
  $opt->define($popt,'lname','',"<name>\t: name of list ");
  
  # Optional root pattern for search with STC CDROMs
  $opt->define($popt,'rpat','id[\d\.]+',
	       "<pat>\t: perl root pattern for file search. This pattern will\n" .
	       "\t\t  be substituted from the original root path ");
  
  # Optional loc file specifying the cdrom name where an id can be found. 
  # This is made because of the different naming conventions of our cdroms...
  $opt->define($popt,'loc',$opt->{ldir}{string} . $corp . '_loc.list',
	       "<loc>\t: list file associating IDs to cdrom names\n\t\t  ");
  $opt->{loc}{Root} = ();
  
}

#----------------------------------------------------------------------
# MAIN
#----------------------------------------------------------------------

# Initialisations
my $glob = new GLOBALS;

$glob->{GLOBALS_PATH} = "$ENV{HOME}/db/";
$glob->{DEF_GLOBALS} =  $glob->{GLOBALS_PATH} . 'deu/globals.pl';
$glob->requireglob;

my @corpuslist = keys %{$GLOBALS::CORPUS_H};
my $CORPUS = $corpuslist[0];

# Define the set of options

my $OptL = new OPTIONS;

$OptL->list(Do => 0, Usage => "display list of corpuses available for default language");
$OptL->help(Do => 0, Usage => "display a more detailled help");
$OptL->locreate(Do => 0, Usage => "creates location list only");
$OptL->esp(string => '(defined in globals.pl)', Usage => "original speech files extension");
$OptL->elist(string => '.full', Usage => "file list extension");

# Corpus and database dependent options
define_options($CORPUS,$OptL,undef);

# Remember initial settings
my $InitOptL = new OPTIONS;
$InitOptL->copy($OptL);

#----------------------------------------------------------------------
# Command processing
#----------------------------------------------------------------------

$OptL->GetOpt || die "Check your options\n";

# Redefine options to take care of changes
define_options($CORPUS,$OptL,$InitOptL);

# Check arguments

# Check the language and reload globals if necessary
if ($OptL->{groot}{string} ne $GLOBALS::GLOBALS_PATH or 
    $OptL->{lang}{string} ne $GLOBALS::DBLANG) {
  $glob->{GLOBALS_PATH} = $OptL->{groot}{string};
  $glob->{DEF_GLOBALS}  = $OptL->{groot}{string}. $OptL->{lang}{string} . '/globals.pl';
  $glob->requireglob;
}

# Extract new corpus list
@corpuslist = keys %{$GLOBALS::CORPUS_H};

# Should we list available corpuses ?
if ($OptL->{list}{Do}) {
  # List of available corpuses
  warn "Available corpus for language $OptL->{lang}{string}: @corpuslist\n";
  exit 0;
}

# Do we have any corpus to treat ?
if (!($CORPUS=$ARGV[0])) {
  warn "Which corpus should be treated ?\n";
  $CORPUS = $corpuslist[0];
  define_options($CORPUS,$OptL,$InitOptL);
  $OptL->Usage('corpus', join('',@::uhelp));
}
else {
  if (exists($GLOBALS::CORPUS_H->{$CORPUS})) {
    define_options($CORPUS,$OptL,$InitOptL);
    warn "generating lists for $CORPUS and language $OptL->{lang}{string}\n";
  } else { die "corpus $CORPUS unknown for language $OptL->{lang}{string}\n";}
}

#------------------------------------------------------------------------------------
# Main
#------------------------------------------------------------------------------------

# Generate list of SAM extensions for the speech files of the choosen language
if (!defined($GLOBALS::CORPUS_H->{$CORPUS}{ext_list}) ){
  $GLOBALS::CORPUS_H->{$CORPUS}{ext_list} = GenSAMExtList($OptL->{lang}{string},'Samples');
}
# Extract some infos
my @lists =  @{$GLOBALS::CORPUS_H->{$CORPUS}{db_dirs}};
if ($OptL->{lname}{string} ne '') {@lists = ($OptL->{lname}{string});}
warn 'lists to be created: ', join(' ',@lists), "\n";
my $ext_list = [$OptL->{esp}{string}];
if ($OptL->{esp}{string} =~ m/\(.*\)/) {$ext_list = $GLOBALS::CORPUS_H->{$CORPUS}{ext_list};}
warn 'ext. list: ', join(" ",@{$ext_list}), "\n";


# Test the existence of the list directory
if (-d $OptL->{ldir}{string}) {
  warn "creating speech files lists in $OptL->{ldir}{string}\n";
  
  # Generate a list for each database directory
  foreach ( @lists  ) {
    warn "create list file for: $_\n";
    GenerateList($OptL,$_,$ext_list,$CORPUS);
  }
} else {die "Error: List directory $OptL->{ldir}{string} not existent !!\n";}

# Write location file
$OptL->LocationWrite($CORPUS);

if ($CORPUS eq 'vm') {
  # These dialogs contain German and English utterances (English is with German accent)
  system("grep -v 's[0-9][0-9][0-9][a-z]' $OptL->{ldir}{string}/vm12.list > $OptL->{ldir}{string}/vm12-GerDia.list") == 0 
    or die 'system grep with corpus vm failed';
}

exit;

__END__

=head1 COMMANDS

The following commands are defined:

=over 10

=item -help	

  display a more detailled help

=item -list	

  display list of corpuses available for default language

=item -locreate	

  creates location list only

=back

=head1 OPTIONS

The following options are defined:

=over 14

=item -dsound I<dir>	

  root directory for speech sound files  
  (default: /cdromserv/views_pc/)

=item -elist I<ext>

  file list extension 
  (default: .full)

=item -esp I<ext>	

  original speech files extension 
  (default: (defined in globals.pl))

=item -groot I<dir>	

  global path  
  (default: /home/giron1/db/)

=item -lang I<Iso3>	

  language three letters code from Iso 3166/2T  
  (default: deu)

=item -ldir I<dir>	

  lists root directory of the defined corpus

=item -lname I<name>	

  name of list  
  (default: )

=item -loc I<loc>	

  list file associating IDs to cdrom names

=item -rpat I<pat>	

  perl root pattern for file search. This pattern will
  be substituted from the original root path
 (default: id[\d\.]+)

=back
